home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / c7105.zip / CHLDGRPS.TPX < prev    next >
Text File  |  1994-03-02  |  9KB  |  207 lines
  1. #!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
  2. #!│                              ChldGrps.TPX              │Version: 3007.105│
  3. #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
  4. #!│Structure             Type       Description                              │
  5. #!│────────────────────  ─────────  ─────────────────────────────────────────│
  6. #!│SetChildSymbols       GROUP      Setup Code Generation Flags              │
  7. #!│GetChildSecondary     GROUP      Perform Many:1 Lookups                   │
  8. #!│ChildInitFields       GROUP      Initialize Fields for INSERTed record    │
  9. #!│NullParentCheck       GROUP      Check if Parent is Empty                 │
  10. #!│HoldParentRecord      GROUP      Hold parent Rec during execution of CHILD│
  11. #!│UpdateChildRecords    GROUP      Perform update to CHILD records          │
  12. #!│PutParentFile         GROUP      Put parent after execution of CHILD      │
  13. #!│FillQueueFields       GROUP      Fill up the List Box                     │
  14. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  15. #!│Version   Comments                                                        │
  16. #!│────────  ────────────────────────────────────────────────────────────────│
  17. #!│3007.000  Release of CDD3 version 3007 templates                          │
  18. #!│3007.105  Repaired NullParentCheck Group                                  │
  19. #!│          Repaired HoldParentRecord Group                                 │
  20. #!└──────────────────────────────────────────────────────────────────────────┘
  21. #!
  22. #GROUP(%SetChildSymbols)
  23. #IF(%ParentFile = %Null)
  24.   #SET(%ErrorMessage, (%Procedure & ' ERROR: Parent File is required.'))
  25.   #ERROR(%ErrorMessage)
  26. #ENDIF
  27. #SET(%MemoExists,%Null)
  28. #FIX(%File,%Primary)
  29. #FIX(%Relation,%ParentFile)
  30. #IF(%RelationType = 'MANY:1')
  31.   #FOR(%RelationKeyField)
  32.     #SET(%ParentRelationField, %RelationKeyField)
  33.     #SET(%ChildRelationField, %RelationKeyFieldLink)
  34.     #BREAK
  35.   #ENDFOR
  36. #ENDIF
  37. #SET(%ScreenFldSetupExists,%Null)
  38. #FIX(%File,%Primary)
  39. #FOR(%Field)
  40.   #IF(%FieldType = 'MEMO')
  41.     #SET(%MemoExists,'Yes')
  42.     #BREAK
  43.   #ENDIF
  44. #ENDFOR
  45. #SET(%FixRows, '0')
  46. #SET(%ListField,'?List')
  47. #FIX(%ScreenField,%ListField)
  48. #FOR(%ScreenFieldFix)
  49.   #SET(%FixRows, (%FixRows + 1))
  50. #ENDFOR
  51. #FOR(%ScreenField)
  52.   #IF(%ScreenFieldSetup)
  53.     #SET(%ScreenFldSetupExists,'YES')
  54.     #BREAK
  55.   #ENDIF
  56. #ENDFOR
  57. #SET(%FirstEntryField,%Null)
  58. #FOR(%ScreenField)
  59.   #IF(%ScreenFieldSkip = %Null)
  60.     #SET(%FirstEntryField,%ScreenField)
  61.     #BREAK
  62.   #ENDIF
  63. #ENDFOR
  64. #FOR(%Field)
  65.   #IF(%FieldInitial <> %NULL)
  66.     #SET(%InitRoutine,'TRUE')
  67.     #BREAK
  68.   #ENDIF
  69. #ENDFOR
  70. #!***************************************************************************
  71. #GROUP(%GetChildSecondary)
  72.   #FOR(%Secondary)                             #! for fields in the list box
  73.     #IF(%Secondary <> %ParentFile)
  74.       #IF(%SecondaryType = 'MANY:1')           #!Check for lookup files
  75.         #FIX(%File,%SecondaryTo)
  76.         #FIX(%Relation,%Secondary)
  77.         #FOR(%RelationKeyField)
  78. IF %RelationKeyField <> %RelationKeyFieldLink  #<!If Link fields don't match
  79.   %RelationKeyField = %RelationKeyFieldLink    #<! Assign linking field value
  80. END                                            #<!End IF
  81.         #ENDFOR
  82. GET(%Secondary,%RelationKey)                  #<! Lookup record
  83.         #FIX(%File,%Secondary)
  84. IF ERRORCODE()                                #<! Clear record if unsuccessful
  85.   #INSERT(%ClearFileFields)
  86. END
  87.       #ENDIF
  88.     #ENDIF
  89.   #ENDFOR
  90. #!***************************************************************************
  91. #GROUP(%ChildInitFields)
  92. #IF(%InitRoutine = 'TRUE')
  93. InitializeFields ROUTINE
  94. #FOR(%Field)
  95. #IF(%FieldInitial <> %NULL)
  96.   %Field = %FieldInitial
  97. #ENDIF
  98. #ENDFOR
  99. #ENDIF
  100. #!***************************************************************************
  101. #GROUP(%NullParentCheck)
  102.   #IF(%NullParentExit)
  103.     #FIX(%File,%ParentFile)
  104. IF %FilePre:RECORD = ''                        #<!If Parent record is blank
  105.   DO ProcedureReturn                           #<! Return to the caller
  106. END                                            #<!End IF
  107.     #FIX(%File,%Primary)
  108.   #ENDIF
  109. #!***************************************************************************
  110. #GROUP(%HoldParentRecord)
  111.   #IF(%SharedFiles)
  112. HOLD(%ParentFile,5)                            #<! When sharing the files
  113. IF ERRORCODE() = isLockedErr                   #<! Hold the parent record.
  114.   #INSERT(%ParentLockedMsg)
  115.   DO ProcedureReturn                           #<!  and exit
  116. END                                            #<! End IF
  117.   #ENDIF
  118. #!***************************************************************************
  119. #GROUP(%UpdateChildRecords)
  120. #FIX(%File,%Primary)
  121. #FIX(%Relation,%ParentFile)
  122. LOOP                                           #<!For child records
  123.   NEXT(%Primary)                               #<! Get the next record
  124.   IF ERRORCODE()                               #<! IF Reading past EOF()
  125.     BREAK                                      #<!  BREAK out of the LOOP
  126.   #FOR(%RelationKeyField)
  127.     #IF(%RelationKeyFieldLink)
  128.   ELSIF %RelationKeyFieldLink <> %RelationKeyField #<! or no child records
  129.     BREAK                                      #<!  BREAK out of the LOOP
  130.     #ENDIF
  131.   #ENDFOR
  132.   END                                          #<! End IF
  133.   SAV:SaveRecord = %FilePre:RECORD             #<! Fill the Queue
  134.   GET(RecordQueue %SortString)                 #<! Get the matching QUEUE
  135.   IF ERRORCODE()                               #<! If Not found
  136.     DELETE(%Primary)                           #<!  Delete the file entry
  137.   ELSIF SAV:SaveRecord <> %FilePre:RECORD      #<! Else if Records don't match
  138.     DELETE(%Primary)                           #<!  Delete the file entry
  139. #FOR(%Field)
  140.   #IF(%FieldType = 'MEMO')
  141.   ELSIF SAV:%FieldID <> %Field                 #<! Else if Records don't match
  142.     DELETE(%Primary)                           #<!  Delete the file entry
  143.   #ENDIF
  144. #ENDFOR
  145.   ELSE                                         #<! Else
  146.     SAV:SkipRecord = 1                         #<!  Mark QUEUE record as skip
  147.     PUT(RecordQueue %SortString)               #<!  and PUT() back in QUEUE
  148.   END                                          #<! End IF
  149.   IF ERRORCODE()                               #<! If error on delete or PUT
  150.     TransactionError = ERRORCODE()             #<!  Save the error code
  151.     BREAK                                      #<!  and BREAK out of the loop
  152.   END                                          #<! End IF
  153. END                                            #<!End LOOP
  154. RecordEntryOne = %FixRows + 1                  #<!
  155. LOOP I = RecordEntryOne TO QRecs               #<! Loop through Queue
  156.   GET(RecordQueue,I)                           #<!  Get a QUEUE Element
  157.   IF ERRORCODE() THEN STOP(ERROR()).           #<!  Stop if Unexpected error
  158.   IF SAV:SkipRecord THEN CYCLE.                #<!  Skip unmodified records
  159.   %FilePre:RECORD = SAV:SaveRecord             #<!  Restore the Record
  160.   #FOR(%Field)
  161.     #IF(%FieldType = 'MEMO')
  162.       #SET(%MemoField,%FieldID)
  163.   %Field = SAV:%FieldID                        #<!  Restore the Memos
  164.     #ENDIF
  165.   #ENDFOR
  166.   ADD(%Primary)                                #<!  Add to the file.
  167.   IF ERRORCODE()                               #<!  If error during ADD
  168.     TransactionError = ERRORCODE()             #<!    Save the error
  169.     BREAK                                      #<!    and break from the loop
  170.   END                                          #<!  End IF
  171. END                                            #<! End LOOP
  172. #!***************************************************************************
  173. #GROUP(%PutParentFile)
  174.   #IF(%SharedFiles)
  175.     #IF(%PutParent)
  176. PUT(%ParentFile)                               #<!Put the parent record
  177. IF ERRORCODE()
  178.   #INSERT(%ParentWriteErrMsg)
  179. END
  180.     #ELSE
  181. RELEASE(%ParentFile)                           #<!Release the held record
  182.     #ENDIF
  183.   #ENDIF
  184. #!***************************************************************************
  185. #GROUP(%FillQueueFields)
  186. #FIX(%File, %ParentFile)
  187. #FIX(%Relation,%Primary)
  188. #IF(%RelationType = '1:MANY')
  189.   #FOR(%RelationKeyField)
  190.     #IF(%RelationKeyFieldLink)
  191. %RelationKeyField = %RelationKeyFieldLink      #<!Assign linking field value
  192.     #ENDIF
  193.   #ENDFOR
  194. #ENDIF
  195. #FIX(%ScreenField,'?List')
  196. SAV:Line = %ScreenFieldExpression              #<! Fill the DisplayQueue line
  197. #FIX(%File, %Primary)
  198. SAV:SaveRecord = %FilePre:RECORD               #<! Fill the QUEUE Record
  199. #FOR(%Field)
  200.   #IF(%FieldType = 'MEMO')
  201.   #SET(%MemoField,%FieldID)
  202.   SAV:%FieldID = %Field                        #<! Fill the QUEUE Memo
  203.   #ENDIF
  204. #ENDFOR
  205. #!***************************************************************************
  206. #CHAIN('FormGrps.TPX')
  207.